home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / win9591a / appbar.bas next >
BASIC Source File  |  1999-07-06  |  4KB  |  149 lines
  1. Attribute VB_Name = "CBAppBar"
  2.  
  3.  
  4. Option Explicit
  5.  
  6.  
  7. ' CONST Section ---------------------------------------------------------------
  8.  
  9. ' SetWindowLong selectors
  10. Const GWL_WNDPROC = -4&
  11.  
  12. ' Windows messages
  13. Const WM_ACTIVATE = &H6
  14. Const WM_GETMINMAXINFO = &H24
  15. Const WM_ENTERSIZEMOVE = &H231
  16. Const WM_EXITSIZEMOVE = &H232
  17. Const WM_MOVING = &H216
  18. Const WM_NCHITTEST = &H84
  19. Const WM_NCMOUSEMOVE = &HA0
  20. Const WM_SIZING = &H214
  21. Const WM_TIMER = &H113
  22. Const WM_WINDOWPOSCHANGED = &H47
  23.  
  24. ' AppBar's user notification message
  25. Const WM_USER = &H400
  26. Const WM_APPBARNOTIFY = WM_USER + 100
  27.  
  28. ' Subclassing function default result
  29. Const INHERIT_DEFAULT_CALLBACK = -1
  30.  
  31.  
  32. ' VAR Section -----------------------------------------------------------------
  33.  
  34. Private ghWnd As Long
  35. Private gAppBar As TAppBar
  36. Private gpcbOldWindowProc As Long
  37.  
  38.  
  39. ' DECL Section ----------------------------------------------------------------
  40.  
  41. Private Declare Function SetWindowLong _
  42.                 Lib "user32" _
  43.                 Alias "SetWindowLongA" _
  44.                 (ByVal hwnd As Long, _
  45.                  ByVal nIndex As Long, _
  46.                  ByVal dwNewLong As Long) As Long
  47.  
  48. Private Declare Function CallWindowProc _
  49.                 Lib "user32" _
  50.                 Alias "CallWindowProcA" _
  51.                 (ByVal lpPrevWndFunc As Any, _
  52.                  ByVal hwnd As Long, _
  53.                  ByVal uMsg As Long, _
  54.                  ByVal wParam As Long, _
  55.                  ByVal lParam As Long) As Long
  56.                  
  57.  
  58. ' FUNCTION Section ------------------------------------------------------------
  59.  
  60. ' LinkCallback ----------------------------------------------------------------
  61. Public Function LinkCallback(ByVal frmInstance As Form, _
  62.                              ByVal clsInstance As TAppBar)
  63.   ' Store the calling window
  64.   ghWnd = frmInstance.hwnd
  65.   
  66.   ' Store the AppBar class instance
  67.   Set gAppBar = clsInstance
  68.   
  69.   ' Subclass the window procedure
  70.   gpcbOldWindowProc = SetWindowLong(ghWnd, _
  71.                                     GWL_WNDPROC, _
  72.                                     AddressOf lfnAppBarCallback)
  73. End Function
  74.  
  75. ' DetachCallback --------------------------------------------------------------
  76. Public Function DetachCallback()
  77.   
  78.   ' Restore the original window procedure
  79.   SetWindowLong ghWnd, GWL_WNDPROC, gpcbOldWindowProc
  80.  
  81. End Function
  82.  
  83. ' AppBar Callback function ----------------------------------------------------
  84. Private Function lfnAppBarCallback(ByVal hwnd As Long, _
  85.                            ByVal uMsg As Long, _
  86.                            ByVal wParam As Long, _
  87.                            ByVal lParam As Long) As Long
  88.   
  89.   ' Message Result to be returned by the Callback
  90.   Dim Result As Long
  91.   
  92.   ' Set the standard return value
  93.   Result = INHERIT_DEFAULT_CALLBACK
  94.   
  95.   ' Subclass some events BEFORE the default window procedure
  96.   Select Case uMsg
  97.     
  98.     Case WM_APPBARNOTIFY
  99.       Result = gAppBar.OnAppBarCallbackMsg(wParam, lParam)
  100.     
  101.     Case WM_ENTERSIZEMOVE
  102.       Result = gAppBar.OnEnterSizeMove
  103.     
  104.     Case WM_EXITSIZEMOVE
  105.       Result = gAppBar.OnExitSizeMove
  106.       
  107.     Case WM_GETMINMAXINFO
  108.       Result = gAppBar.OnGetMinMaxInfo(lParam)
  109.     
  110.     Case WM_MOVING
  111.       Result = gAppBar.OnMoving(lParam)
  112.       
  113.     Case WM_NCMOUSEMOVE
  114.       gAppBar.OnNcMouseMove
  115.       
  116.     Case WM_SIZING
  117.       Result = gAppBar.OnSizing(wParam, lParam)
  118.       
  119.     Case WM_TIMER
  120.       gAppBar.OnAppBarTimer
  121.   
  122.   End Select
  123.   
  124.   ' If the subclassing function did not provide a return value
  125.   ' or wants to inherit the default procedure
  126.   If Result = INHERIT_DEFAULT_CALLBACK Then
  127.     ' Call the default window procedure
  128.     Result = CallWindowProc(gpcbOldWindowProc, hwnd, uMsg, wParam, lParam)
  129.   End If
  130.   
  131.   ' Subclass some events AFTER the default window procedure
  132.   Select Case uMsg
  133.     
  134.     Case WM_ACTIVATE
  135.       gAppBar.OnActivate wParam
  136.     
  137.     Case WM_NCHITTEST
  138.       gAppBar.OnNcHitTest lParam, Result
  139.     
  140.     Case WM_WINDOWPOSCHANGED
  141.       gAppBar.OnWindowPosChanged
  142.   
  143.   End Select
  144.   
  145.   ' Return the value set by the subclassing function or by the default proc
  146.   lfnAppBarCallback = Result
  147.  
  148. End Function
  149.